private subroutine Variogr(varmodel, h, alpha, gam)
calculation of the variogram value in 2D
Arguments
| Type |
Intent | Optional | Attributes |
|
Name |
|
|
integer(kind=short),
|
intent(in) |
|
|
:: |
varmodel |
|
|
real(kind=float),
|
intent(inout) |
|
|
:: |
h |
|
|
real(kind=float),
|
intent(in) |
|
|
:: |
alpha |
|
|
real(kind=float),
|
intent(out) |
|
|
:: |
gam |
|
Variables
| Type |
Visibility | Attributes |
|
Name |
| Initial | |
|
real(kind=float),
|
public |
|
:: |
caa |
|
|
|
|
real(kind=float),
|
public |
|
:: |
cab |
|
|
|
|
real(kind=float),
|
public |
|
:: |
cac |
|
|
|
|
real(kind=float),
|
public |
|
:: |
dc2 |
|
|
|
|
real(kind=float),
|
public |
|
:: |
ds2 |
|
|
|
|
real(kind=float),
|
public |
|
:: |
dx |
|
|
|
|
real(kind=float),
|
public |
|
:: |
dy |
|
|
|
|
real(kind=float),
|
public |
|
:: |
w |
|
|
|
|
real(kind=float),
|
public |
|
:: |
x |
|
|
|
|
real(kind=float),
|
public |
|
:: |
y |
|
|
|
|
real(kind=float),
|
public |
|
:: |
zero |
|
|
|
Source Code
SUBROUTINE Variogr &
!
(varModel, h, alpha, gam)
IMPLICIT NONE
!arguments with intent(in):
REAL (KIND = float), INTENT(IN) :: alpha
INTEGER (KIND = short), INTENT (IN) :: varmodel
!arguments with intent(out)
REAL (KIND = float), INTENT(OUT) :: gam
!arguments with intent(inout)
REAL (KIND = float), INTENT(INOUT) :: h
!local declaration:
REAL (KIND = float) :: zero
REAL (KIND = float) :: caa, cab, cac, dc2, ds2, x, y, dx, dy, w
!-------------------------------------end of declarations----------------------
zero = 0.000001
gam = 0.0
IF (h < zero) RETURN
gam = nugget
caa = 1.0
cab = 1.0
cac = 0.0
IF ( anisotropyRatio > 1.0 ) THEN
dc2 = COS(anisotropyAngle)**2
ds2 = SIN(anisotropyAngle)**2
caa = dc2 + anisotropyRatio * ds2
cab = ds2 + anisotropyRatio * dc2
cac = ( 1.0 - anisotropyRatio ) * SIN(anisotropyAngle) * COS(anisotropyAngle)
END IF
x = h * COS(alpha)
y = h * SIN(alpha)
dx = x * caa + y * cac
dy = x * cac + y * cab
h = SQRT ( dx * dx + dy * dy )
IF ( varModel == 1) THEN !Spherical
w = 1.5 * h / range - 0.5 * h * h * h / ( range * range * range )
IF (h > range) w = 1.0
ELSE IF ( varModel == 2) THEN !Exponential
w = 1.0 - EXP ( -3*h / range )
!w = 1.0 - EXP ( - h / range )
ELSE IF ( varModel == 3) THEN !Gaussian
w = 1.0 - EXP ( -10*h * h / (range * range) )
ELSE IF ( varModel == 4) THEN !Power
w = h ** range
END IF
gam = gam + w * partialSill
RETURN
END SUBROUTINE Variogr
